home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v10n01.arc / MAKECLIP.BAS < prev    next >
BASIC Source File  |  1990-12-11  |  2KB  |  83 lines
  1. 10 '  MAKECLIP.BAS  Clipper Version
  2. 20 '  Generate a procedure to recreate a .DBF or other file
  3. 100 CLS
  4. 110 ALPHA$ = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVW"
  5. 115 ALPHA$ = ALPHA$ + "XYZ1234567890`~-_=+;:<>,.?/|\!@#$%^&*()"
  6. 120 LINE INPUT "dBASE file to read :", S$
  7. 130 IF INSTR(S$, ".") = 0 THEN S$ = S$ + ".dbf"
  8. 140 ON ERROR GOTO 740
  9. 150 OPEN S$ FOR INPUT AS #1
  10. 160 CLOSE 1: ON ERROR GOTO 0
  11. 170 LINE INPUT "Procedure file to append to :", T$
  12. 172 IF T$ = "" THEN 170
  13. 180 IF INSTR(T$, ".") = 0 THEN T$ = T$ + ".prg"
  14. 190 LINE INPUT "Procedure name :", P$: IF P$ = "" THEN 190
  15. 200 OPEN S$ FOR RANDOM AS #1 LEN = 1
  16. 210 FIELD 1, 1 AS A$: FL = LOF(1)
  17. 220 GET 1, FL: IF A$ = CHR$(26) THEN FL = FL - 1
  18. 230 OPEN T$ FOR APPEND AS #2
  19. 240 PRINT #2, "PROCEDURE "; P$
  20. 250 PRINT #2, "PARAMETER F_TMP"
  21. 260 PRINT #2, "NL=CHR(0)"
  22. 270 PRINT #2, "IF PCOUNT()=0"
  23. 280 PRINT #2, "  SET ALTERNATE TO "; S$
  24. 290 PRINT #2, "ELSE"
  25. 300 PRINT #2, "   SET ALTE TO &F_TMP"
  26. 310 PRINT #2, "ENDIF"
  27. 320 PRINT #2, "SET ALTERNATE ON"
  28. 330 PRINT #2, "SET CONSOLE OFF"
  29. 340 PRINT #2, "?? ";
  30. 350 LC = 0
  31. 360 FOR Y = 1 TO FL
  32. 370   GET 1, Y
  33. 380   LC = LC + 1
  34. 390   IF A$ <> CHR$(0) THEN 490
  35. 395   IF Y = FL THEN GOTO 650
  36. 400   NLCNT = 0
  37. 410   WHILE A$ = CHR$(0)
  38. 420     NLCNT = NLCNT + 1
  39. 430     Y = Y + 1
  40. 440     GET 1, Y
  41. 445     IF Y = FL THEN GOTO 460
  42. 450   WEND
  43. 460   Y = Y - 1
  44. 470   IF NLCNT = 1 THEN PRINT #2, "NL"; : GOTO 660
  45. 480   PRINT #2, "REPL(NL," + MID$(STR$(NLCNT), 2) + ")"; : GOTO 660
  46. 490   IF INSTR(ALPHA$, A$) = 0 THEN 650
  47. 500   PRINT #2, CHR$(34);
  48. 510   QCNT = 0
  49. 520   WHILE INSTR(ALPHA$, A$) <> 0 AND Y <= FL
  50. 530     QCNT = QCNT + 1
  51. 540     IF QCNT > 50 THEN GOSUB 810
  52. 550     PRINT #2, A$;
  53. 560     Y = Y + 1
  54. 570     GET 1, Y
  55. 580   WEND
  56. 590   Y = Y - 1
  57. 600   PRINT #2, CHR$(34);
  58. 610   IF Y >= FL THEN 670
  59. 620   LC = LC + INT(QCNT / 10)
  60. 630   IF LC > 7 THEN LC = 7
  61. 640   GOTO 660
  62. 650   PRINT #2, "CHR("; MID$(STR$(ASC(A$)), 2); ")";
  63. 660   IF LC >= 7 THEN GOSUB 910 ELSE IF Y <> FL THEN PRINT #2, "+";
  64. 670 NEXT
  65. 680 PRINT #2,
  66. 690 PRINT #2, "SET ALTERNATE OFF"
  67. 700 PRINT #2, "SET ALTERNATE TO"
  68. 710 PRINT #2, "SET CONSOLE ON"
  69. 715 PRINT #2, "RETURN"
  70. 720 CLOSE 1, 2
  71. 730 END
  72. 740 PRINT : PRINT "Invalid filename."
  73. 750 RESUME 120
  74. 800 '
  75. 810 PRINT #2, CHR$(34): PRINT #2, "?? "; CHR$(34);
  76. 820 LC = 1: QCNT = 1
  77. 830 RETURN
  78. 900 '
  79. 910 IF Y = FL THEN RETURN
  80. 920 PRINT #2, : PRINT #2, "?? "; : LC = 0
  81. 930 RETURN
  82.  
  83.